home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
095
/
rfix0424.arc
/
R-PC0424.MRG
< prev
next >
Wrap
Text File
|
1988-04-24
|
16KB
|
395 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against rbbs-pc.bas to produce r-pc0424.bas
* rbbs-pc.bas: Date 3-25-1988 Size 216139 bytes
* ------------[ Created 04-24-1988 09:52:02 ]------------
* REPLACING old line(s) by new
* ------[ first line different ]------
105 VERSION.ID$ = "CPC16.1A with fixes through 04-24-88" ' TF042401
XOFF$ = CHR$(19)
XON$ = CHR$(17)
INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
' ******************** Logon Error Message Table ****************************
* REPLACING old line(s) by new
150 IF SUB.BOARD THEN _
GOSUB 12987 : _
GOSUB 5135 : _
GOTO 165
SYSOP.AVAILABLE = VAL(MID$(MESSAGE.RECORD$,32,2))
SYSOP.ANNOY = VAL(MID$(MESSAGE.RECORD$,34,2))
SYSOP.NEXT = VAL(MID$(MESSAGE.RECORD$,36,2))
PRINTER = VAL(MID$(MESSAGE.RECORD$,38,2))
IF TURN.PRINTER.OFF THEN _
PRINTER = FALSE
EXIT.TO.DOORS = VAL(MID$(MESSAGE.RECORD$,40,2))
EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
MID$(MESSAGE.RECORD$,57,1) = "I"
PRIVATE.DOOR = VAL(MID$(MESSAGE.RECORD$,72,2))
MID$(MESSAGE.RECORD$,72,2) = STR$(FALSE)
* ------[ first line different ]------
LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2)) ' TF033101
IF EXIT.TO.DOORS OR PRIVATE.DOOR THEN _
TURBO.LOGON = TRUE
PUT 1,NODE.RECORD.INDEX
GOSUB 12985
'
' *****************************************************************************
' * TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER *
' *****************************************************************************
'
* REPLACING old line(s) by new
175 GOSUB 5344
IF DIR.CATEGORY.FILE$ <> PREV.DIRCAT$ THEN _
PREV.DIRCAT$ = DIR.CATEGORY.FILE$ : _
CALL CTLINES (MAX.ENTRIES) : _
REDIM CATEGORY.NAME$(MAX.ENTRIES),CATEGORY.CODE$(MAX.ENTRIES),_
CATEGORY.DESC$(MAX.ENTRIES) : _
CALL INITFMS (CATEGORY.NAME$(),CATEGORY.CODE$(), _
CATEGORY.DESC$(),NUM.CATEGORIES)
LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")
REMOTE.ECHO = (DEFAULT.ECHOER$ = "R" AND NOT LOCAL.USER.MODE)
CALL BRKFNAME (CALLERS.FILE$,DRV$,X$,Y$,TRUE)
NODE.WORK.FILE$ = DRV$ + _
"NODE" + _
NODE.ID$ + _
"WRK.BAT"
SECONDS.PER.SESSION! = MINUTES.PER.SESSION! * 60
IF NOT LOCAL.USER.MODE THEN _
* ------[ first line different ]------
IF NOT EXIT.TO.DOORS THEN _ ' TF033101
GOTO 180 _ ' TF033101
ELSE IF NOT LOCAL.USER THEN _ ' TF033101
GOTO 180 ' TF033101
LOCAL.USER = TRUE
BPS = -7
BAUD.TEST = 19200
EIGHT.BIT = TRUE
SNOOP = TRUE
RECYCLE.TO.DOS = TRUE
IF EXIT.TO.DOORS THEN _
CALL AMORPM : _
CALL READPROF : _
GOTO 410
GOSUB 178
GOTO 345
* REPLACING old line(s) by new
821 CALL TRIM (CI$)
IF PRIVATE.DOOR AND _
TRANSFER.FUNCTION = 3 THEN _
TRANSFER.FUNCTION = 0 : _
GOTO 832
IF REGISTRATION.PROGRAM$ = "NONE" OR _
REGISTRATION.PROGRAM$ = "" THEN _
GOTO 832
* ------[ first line different ]------
B$ = REGISTRATION.PROGRAM$ ' TF033105
TRANSFER.FUNCTION = 3 ' TF033105
CALL XFRETURN
'
' *****************************************************************************
' * ESC PRESSED ON LOCAL CONSOLE ENTERS HERE *
' *****************************************************************************
'
* REPLACING old line(s) by new
822 LOCATE 24,1
CALL FINDTIME (USER.LOGON.TIME!)
CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
LOCAL.USER = TRUE
* ------[ first line different ]------
SNOOP = TRUE ' TF033103
WAIT.BEFORE.DISCONNECT = 32400
BPS = -7
CALL MUZAK (2)
IF LOCAL.PASSWORD$ = "NONE" THEN _
GOTO 828
D$ = "Enter PASSWORD (dots echo) "
GOSUB 1310
Z$ = ""
INKEYS.PRESSED = 0
* REPLACING old line(s) by new
836 IF LOCAL.USER THEN _
* ------[ first line different ]------
TALK.TO.MODEM.AT$ = "19200" : _ ' TF033101
BAUD.PARITY$ = "19200 BAUD,N,8,1" : _ ' TF033101
SNOOP = TRUE : _
LINE.FEEDS = TRUE : _
A = INSTR(TRANSFER.OPTIONS$,CARRIAGE.RETURN$) : _
IF A > 0 THEN _
MID$(TRANSFER.OPTIONS$,A,1) = " "
* REPLACING old line(s) by new
1235 Z$ = B$(1)
IF LEN(Z$) < 1 THEN _
GOTO 1230
CALL ALLCAPS (Z$)
CALL SRCHCMND (SUB.SECTION,FF)
IF FF < 1 THEN _
* ------[ first line different ]------
CALL QTPUT ("Unknown command <"+Z$+">",1) : _ ' TF041701
GOTO 1230
* REPLACING old line(s) by new
1300 CALL QTPUT ("Message base " + GRN$,1)
RETURN
* ------[ first line different ]------
' ***************************************************************************** ' TF041701
' * COMMON LOCAL DISPLAY PRINT * ' TF041701
' ***************************************************************************** ' TF041701
* DELETING old line(s)
1305
* REPLACING old line(s) by new
2020 IF REPLY THEN _
* ------[ first line different ]------
FOUND = TRUE : _ ' TF041803
GOTO 2060
SUBJECT$ = ""
A$ = "To (Press [ENTER] for All)"
CALL SKIPLINE (1)
GOSUB 12995
IF LEN(B$) > 30 THEN _
A$ = "30 Char. Max" : _
GOSUB 12979 : _
GOTO 2020
* REPLACING old line(s) by new
2620 A$ = "Line #" + _
STR$(L) + _
" is:" + _
RETURN.LINE.FEED$ + _
A$(L)
GOSUB 12977
IF NOT EXPERT.USER THEN _
CALL QTPUT ("Search & replace",1)
A$ = "Search for" + _
PRESS.ENTER.EXPERT$
* ------[ first line different ]------
PARSE.OFF = TRUE ' TF041802
GOSUB 12995
IF Q = 0 THEN _
GOTO 2300
X = INSTR(B$,";") ' TF041802
IF X > 0 THEN _ ' TF041802
X$ = LEFT$(B$,X-1) : _ ' TF041802
Y$ = RIGHT$(B$,LEN(B$)-X) : _ ' TF041802
GOTO 2660 ' TF041802
X$ = B$
A$ = "And replace by"
PARSE.OFF = TRUE ' TF041802
GOSUB 12995
Y$ = B$
* REPLACING old line(s) by new
* ------[ first line different ]------
4371 IF MESSAGES.SELECTED.INDEX <= NUMBER.MESSAGES.SELECTED THEN _ ' TF041603
CALL CHECKINT (B$(MESSAGES.SELECTED.INDEX)) : _ ' TF041603
IF EC <> 0 THEN _ ' TF041603
EL = 4371 : _ ' TF041603
GOTO 13000 _ ' TF041603
ELSE CURRENT.MESSAGE = TESTED.INTEGER.VALUE : _ ' TF041603
GOTO 4415 ' TF041603
* REPLACING old line(s) by new
4561 FF = INSTR(MID$(MESSAGE.RECORD$,X),LEFT$(ACTIVE.USER.NAME$,22))
IF FF > 0 THEN _
X = LEN(ACTIVE.USER.NAME$) + FF : _
IF (FF < 7 OR MID$(MESSAGE.RECORD$,FF - 1,1) = " ") AND (X > 58 OR MID$(MESSAGE.RECORD$,X,1) = " ") THEN _
UH = TRUE _
ELSE IF FF < 37 THEN _
X = 37 : _
GOTO 4561
* ------[ first line different ]------
MSG.TO.CALLER = (UH AND (FF = 37)) OR _ ' TF041203
(MID$(MESSAGE.RECORD$,37,5) = "ALL ") ' TF041203
MSG.FROM.CALLER = UH AND (FF = 6) ' TF041203
* REPLACING old line(s) by new
8050 MESSAGE.FROM$ = MID$(MESSAGE.RECORD$,6,31)
CALL TRIM (MESSAGE.FROM$)
IF LEN(MESSAGE.FROM$) < 23 THEN _
MESSAGE.FROM$ = MESSAGE.FROM$ + _
SPACE$(23 - LEN(MESSAGE.FROM$))
A$ = "Msg # " + _
LEFT$(MESSAGE.RECORD$,5) + _
" Dated " + _
MID$(MESSAGE.RECORD$,68,8) + _
" " + _
MID$(MESSAGE.RECORD$,59,8)
IF USER.SECURITY.LEVEL >= SEC.CHANGE.MSG THEN _
A$ = A$ + _
" Security:" + _
STR$(MESSAGE.SECURITY)
IF NOT RET THEN _
IF READ.MESSAGES THEN _
CALL QTPUT (A$,1): _
CALL QTPUT (" From: " + MESSAGE.FROM$,1) : _
CALL QTPUT (" To: " + MESSAGE.TO$,1) : _
A$ = " Re: " + _
SUBJECT$ _
ELSE A$ = LEFT$(MESSAGE.RECORD$,5) + _
" " + _
MID$(MESSAGE.RECORD$,68,8) + _
" " + _
LEFT$(MESSAGE.TO$,19) + _
" " + _
LEFT$(MESSAGE.FROM$,18) + _
" " + _
LEFT$(SUBJECT$,24) : _
GOTO 8080
IF QUICK.SCAN.MESSAGES OR _
* ------[ first line different ]------
SCAN.MESSAGES THEN _ ' TF041203
GOTO 8080 ' TF041203
IF ((NOT SYSOP) AND NOT (MSG.FROM.CALLER)) THEN _ ' TF041203
GOTO 8077
* REPLACING old line(s) by new
8076 IF MID$(MESSAGE.RECORD$,123,6) = STRING$(6,0) OR _
MID$(MESSAGE.RECORD$,123,6) = SPACE$(6) THEN _
* ------[ first line different ]------
A$ = A$ + " -Not Received-" : _ ' TF041203
GOTO 8077 ' TF041203
YY$ = RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,126,1))),2) + _
":" + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,127,1))),2) + _
":" + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,128,1))),2)
FOR I = 1 TO 8
IF MID$(YY$,I,1) = " " THEN _
MID$(YY$,I,1) = "0"
NEXT
YY$ = YY$ + _
" on "
YY$ = YY$ + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,123,1))),2) + _
"/" + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,124,1))),2) + _
"/" + _
RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,125,1))),2)
FOR I = 13 TO 20
IF MID$(YY$,I,1) = " " THEN _
MID$(YY$,I,1) = "0"
NEXT
A$ = A$ + _
" Received " + _ ' TF041203
YY$
* REPLACING old line(s) by new
* ------[ first line different ]------
8077 IF MSG.FROM.CALLER OR (NOT MSG.TO.CALLER) THEN _ ' TF041203
GOTO 8080 ' TF041203
YY$ = DATE$
WK$ = TIME$
MID$(MESSAGE.RECORD$,123,6) = CHR$(VAL(MID$(YY$,1,2))) + _
CHR$(VAL(MID$(YY$,4,2))) + _
CHR$(VAL(MID$(YY$,9,2))) + _
CHR$(VAL(MID$(WK$,1,2))) + _
CHR$(VAL(MID$(WK$,4,2))) + _
CHR$(VAL(MID$(WK$,7,2)))
GOSUB 12986
PUT 1,M(MESSAGE.DIM.INDEX,1)
GOSUB 12987
* REPLACING old line(s) by new
11520 QUESTIONNAIRE.ABORTED = FALSE
CALL FINDIT (FILE.NAME$)
IF NOT OK THEN _
RETURN
REDIM A$(256)
CALL ASKUSERS
IF ADJUSTED.SECURITY THEN _
GOSUB 12989 : _
LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) : _
GOSUB 9440 : _
GOSUB 12991 : _
CALL CALLOPT : _
GOSUB 5135
REDIM A$(ADIM)
IF SUBROUTINE.PARAMETER = -1 THEN _
* ------[ first line different ]------
RETURN 10595 ' TF041702
RETURN
'
' *****************************************************************************
' * A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER) *
' *****************************************************************************
'
* REPLACING old line(s) by new
* ------[ first line different ]------
13000 IF DEBUG THEN _ ' TF033102
A$ = "RBBS-PC DEBUG Error Trap Entry ERL=" + _
STR$(EL) + _
" ERR=" + _
STR$(EC) : _
CALL PRINTIT(A$) : _
D$ = A$ : _
GOSUB 1315
IF EL = 1905 AND EC = 63 THEN _
CLOSE 1 : _
KILL ACTIVE.MESSAGE.FILE$ : _
GOTO 5350
IF EL = 4371 AND EC = 6 THEN _
GOTO 1200
IF EL = 4740 THEN _
GOTO 4745
IF EL = 5151 AND EC = 62 THEN _
CALL UPDTCALR (PASSWORDS.FILE$ + " bad format!",2) : _
GOTO 5160
IF EL = 7130 AND EC = 53 THEN _
GOTO 7260
IF EL = 20242 AND EC = 62 THEN _
CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
GOTO 20247
IF EL = 20262 THEN _
A$ = "<Download aborted>" : _
DOWNLOAD.COMPLETED = FALSE : _
GOTO 20390
IF EL = 20452 AND EC = 53 THEN _
GOTO 20451
IF EL = 20560 AND EC = 67 THEN _
GOTO 20451
IF EL = 20560 AND EC = 70 THEN _
IF VAL(FREE.SPACE$) > 1999 THEN _
GOTO 20610 _
ELSE CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
GOTO 5160
IF EL = 20620 THEN _
GOTO 20670
IF EL = 20650 THEN _
GOTO 20670
IF EL = 20736 AND EC = 53 THEN _
GOTO 5160
IF EL = 20900 AND EC = 75 THEN _
GOTO 21230
IF EL = 20900 AND EC = 70 THEN _
CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
GOTO 21230
IF EL = 21131 THEN _
EC = 0 : _
GOTO 21230
IF EL = 21480 THEN _
CALL LOGERROR : _
IF EC = 57 THEN _
CALL QTPUT("Error reading file. Aborting download",1) : _
DOWNLOAD.COMPLETED = FALSE : _
GOTO 21230
* REPLACING old line(s) by new
23000 GET 1,1
HIGH.MESSAGE.NUMBER = VAL(LEFT$(MESSAGE.RECORD$,8))
AUTO.ADD.SECURITY = CVI(MID$(MESSAGE.RECORD$,9,2))
CALLS.TODATE! = VAL(MID$(MESSAGE.RECORD$,11,10))
CURRENT.USER.COUNT = VAL(MID$(MESSAGE.RECORD$,57,5))
* ------[ first line different ]------
' HIGHEST.USER.RECORD = VAL(MID$(MESSAGE.RECORD$,62,5)) ' TF042101
FIRST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,68,7))
NEXT.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,75,7))
HIGHEST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,82,7))
NODES.IN.SYSTEM = VAL(MID$(MESSAGE.RECORD$,127))
IF LOCAL.USER.MODE AND NOT SYSOP THEN _
RETURN
IF NOT SYSOP AND NOT LOCAL.USER THEN _
RETURN
IF TEMP.SYSOP THEN _
RETURN
IF LAST.MESSAGE.READ < VAL(MID$(MESSAGE.RECORD$,123,4)) THEN _
LAST.MESSAGE.READ = VAL(MID$(MESSAGE.RECORD$,123,4))
LAST.MESSAGE.READ = - LAST.MESSAGE.READ * _
(LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
RETURN
'
' *****************************************************************************
' * UPDATE MESSAGE HEADER RECORD DATA *
' *****************************************************************************
'